module TupleExtensions

module Tuple =

    type Single<'a>   = Single of 'a
    type Infinite<'a> = Infinite of 'a
    
    module TupleInternalValues =

        type Split = Split with
            static member ($) (_:Split, Infinite x1     ) = (x1, Infinite x1)
            static member ($) (_:Split, Single x1       ) = (x1, ())
            static member ($) (_:Split, (x1,x2)         ) = (x1, Single x2)
            static member ($) (_:Split, (x1,x2,x3)      ) = (x1, (x2,x3))
            static member ($) (_:Split, (x1,x2,x3,x4)   ) = (x1, (x2,x3,x4))
            static member ($) (_:Split, (x1,x2,x3,x4,x5)) = (x1, (x2,x3,x4,x5))
 
        type Join = Join with
            static member ($) (_:Join, ()           ) = fun x -> Single x
            static member ($) (_:Join, Single x1    ) = fun x -> (x,x1)
            static member ($) (_:Join, (x1,x2)      ) = fun x -> (x,x1,x2)
            static member ($) (_:Join, (x1,x2,x3)   ) = fun x -> (x,x1,x2,x3)
            static member ($) (_:Join, (x1,x2,x3,x4)) = fun x -> (x,x1,x2,x3,x4)
 
        let inline (|Cons|) tuple   = Split $ tuple
        let inline Cons (head,tail) = Join $ tail <| head

        type Tmap = Tmap with
            static member inline (?<-) ((),this:Tmap,f)                        = ()
            static member inline (?<-) (Single(x1),this:Tmap,f)                   = Single(f $ x1)
            static member inline (?<-) ((x1,x2),this:Tmap,f)                      = (f $ x1 ,f $ x2)
            static member inline (?<-) ((x1,x2,x3),this:Tmap,f)                   = (f $ x1 ,f $ x2,f $ x3)
            static member inline (?<-) ((x1,x2,x3,x4),this:Tmap,f)                = (f $ x1 ,f $ x2,f $ x3,f $ x4)
            static member inline (?<-) ((x1,x2,x3,x4,x5),this:Tmap,f)             = (f $ x1 ,f $ x2,f $ x3,f $ x4,f $ x5)
            //static member inline (?<-) ((x1,x2,x3,x4,x5,x6),this:Tmap,f)          = (f $ x1 ,f $ x2,f $ x3,f $ x4,f $ x5,f $ x6)
            //static member inline (?<-) ((x1,x2,x3,x4,x5,x6,x7),this:Tmap,f)       = (f $ x1 ,f $ x2,f $ x3,f $ x4,f $ x5,f $ x6,f $ x7)
            //static member inline (?<-) ((x1,x2,x3,x4,x5,x6,x7,x8),this:Tmap,f)    = (f $ x1 ,f $ x2,f $ x3,f $ x4,f $ x5,f $ x6,f $ x7,f $ x8)
            //static member inline (?<-) ((x1,x2,x3,x4,x5,x6,x7,x8,x9),this:Tmap,f) = (f $ x1 ,f $ x2,f $ x3,f $ x4,f $ x5,f $ x6,f $ x7,f $ x8,f $ x9)

        type Rev = Rev with
            static member inline ($) (_:Rev, Cons(h,t)) = fun ac -> Rev $ t <| Cons(h,ac)
            static member        ($) (_:Rev, ()     ) = id        
            
        type Map = Map with
            static member inline ($) (_:Map, Cons(h,t)) = fun fn -> Cons(fn h, Map $ t <| fn)
            static member        ($) (_:Map, ()     ) = ignore        

        type Ap = Ap with
            static member inline ($) (_:Ap, Cons(hf,tf) ) = fun (Cons(hx,tx)) -> Cons(hf hx, Ap $ tf <| tx)
            static member        ($) (_:Ap, ()        ) = ignore
        
        type Fold = Fold with
            static member inline ($) (_:Fold, Cons(h,t)) = fun fn z -> Fold $ t <| fn <| fn z h
            static member        ($) (_:Fold, ()     ) = fun fn z -> z        

        let inline curryStep (f: ^t->'a) =
            let inline s (h:^H) (t:^T) :^t = Cons(h,t)
            fun (h:^H) (t:^T) -> f (Cons(h,t))
        
        type Curry = Curry with
            static member inline ($) (_:Curry, f: ^t->'a) = 
                let inline s (h:^H) (t:^T) :^t = Cons(h,t)
                //fun (h:^H) (t:^T) -> f (Cons(h,t))
                fun (h:^H) (t:^T) -> fun x -> Curry $ ( f (Cons(h,t)) )
            static member        ($) (_:Curry, f:unit->'a) = f


        type Thead = Thead with static member inline ($) (i:Thead,tuple) = (Split $ tuple) |> fst
        type Ttail = Ttail with static member inline ($) (i:Ttail,tuple) = (Split $ tuple) |> snd

        let inline maphead x = x ? (Tmap) <- Thead
        let inline maptail x = x ? (Tmap) <- Ttail

        type Transpose = Transpose with
            static member inline ($) (_:Transpose, matHead : ^a when ^a : not struct ) =
                fun (mat,acc) ->
                    let matRest = maptail mat
                    let matFirst = maphead mat
                    let nextAcc = (Join $ acc) matFirst
                    let (headmatRest,_) = Split $ matRest
                    (Transpose $ headmatRest) (matRest,nextAcc)
            static member inline ($) (_:Transpose, ()) = fun (matrixTail,acc) -> acc
        

    open TupleInternalValues

    let inline head tuple = (Split $ tuple) |> fst
    let inline tail tuple = (Split $ tuple) |> snd
    let inline split tuple = Split $ tuple

    let inline rev tuple            = Rev $ tuple      <| ()
    let inline append tuple1 tuple2 = Rev $ rev tuple1 <| tuple2
    let inline map fn tuple = Map $ tuple <| fn
    let inline (<*>) fnTuple tuple = Ap $ fnTuple <| tuple
    let inline fold fn z tuple = Fold $ tuple <| fn <| z

    let inline transpose mat = rev ( (Transpose $ (head mat)) ( mat,()) )

    
    let inline cons head tail = (Join $ (tail)) head
    let inline tmap f x = x ? (Tmap) <- f
    let inline applySingle f1f2f3_fn x = (Ap $ f1f2f3_fn)  (Infinite x)
    
    

    ////////////////

    let inline first  tuple = head tuple
    let inline second tuple = tail tuple |> first
    let inline third tuple  = tail tuple |> second

    let inline vectorFunction f1f2f3_fn x = map ( (|>) x ) f1f2f3_fn